home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / modes / mail-abbrevs.el.z / mail-abbrevs.el
Encoding:
Text File  |  1998-05-21  |  30.1 KB  |  768 lines
  1. ;;; Abbrev-expansion of mail aliases.
  2. ;;; Copyright (C) 1985-1994 Free Software Foundation, Inc.
  3. ;;; Created: 19 oct 90, Jamie Zawinski <jwz@netscape.com>
  4. ;;; Modified: 5 apr 92, Roland McGrath <roland@gnu.ai.mit.edu>
  5. ;;; Last change  4-may-94. jwz
  6.  
  7. ;; This file is part of XEmacs.
  8.  
  9. ;; XEmacs is free software; you can redistribute it and/or modify it
  10. ;; under the terms of the GNU General Public License as published by
  11. ;; the Free Software Foundation; either version 2, or (at your option)
  12. ;; any later version.
  13.  
  14. ;; XEmacs is distributed in the hope that it will be useful, but
  15. ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  16. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  17. ;; General Public License for more details.
  18.  
  19. ;; You should have received a copy of the GNU General Public License
  20. ;; along with XEmacs; see the file COPYING.  If not, write to the 
  21. ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  22. ;; Boston, MA 02111-1307, USA.
  23.  
  24. ;;; This file ensures that, when the point is in a To:, CC:, BCC:, or From: 
  25. ;;; field, word-abbrevs are defined for each of your mail aliases.  These
  26. ;;; aliases will be defined from your .mailrc file (or the file specified by
  27. ;;; the MAILRC environment variable) if it exists.  Your mail aliases will
  28. ;;; expand any time you type a word-delimiter at the end of an abbreviation.
  29. ;;;
  30. ;;; What you see is what you get: no abbreviations will be expanded after you
  31. ;;; have sent the mail, unlike the old system.  This means you don't suffer
  32. ;;; the annoyance of having the system do things behind your back -- if an
  33. ;;; address you typed is going to be rewritten, you know it immediately,
  34. ;;; instead of after the mail has been sent and it's too late to do anything
  35. ;;; about it.  You will never again be screwed because you forgot to delete an
  36. ;;; old alias from your .mailrc when a new local user arrives and is given a
  37. ;;; userid which conflicts with one of your aliases, for example.
  38. ;;;
  39. ;;; Your mail alias abbrevs will be in effect only when the point is in an
  40. ;;; appropriate header field.  When in the body of the message, or other
  41. ;;; header fields, the mail aliases will not expand.  Rather, the normal
  42. ;;; mode-specific abbrev table (mail-mode-abbrev-table) will be used if 
  43. ;;; defined.  So if you use mail-mode specific abbrevs, this code will not
  44. ;;; adversely affect you.  You can control which header fields the abbrevs
  45. ;;; are used in by changing the variable mail-abbrev-mode-regexp.
  46. ;;;
  47. ;;; If auto-fill mode is on, abbrevs will wrap at commas instead of at word
  48. ;;; boundaries; also, header continuation-lines will be properly indented.
  49. ;;;
  50. ;;; You can also insert a mail alias with mail-interactive-insert-alias
  51. ;;; (bound to C-c C-a), which prompts you for an alias (with completion)
  52. ;;; and inserts its expansion at point.
  53. ;;;
  54. ;;; This file fixes a bug in the old system which prohibited your .mailrc
  55. ;;; file from having lines like
  56. ;;;
  57. ;;;     alias someone "John Doe <doe@quux.com>"
  58. ;;;
  59. ;;; That is, if you want an address to have embedded spaces, simply surround it
  60. ;;; with quotes.  This is necessary because the format of the .mailrc file
  61. ;;; bogusly uses spaces as address delimiters.  The following line defines an
  62. ;;; alias which expands to three addresses:
  63. ;;;
  64. ;;;     alias foobar addr-1 addr-2 "address three <addr-3>"
  65. ;;;
  66. ;;; (This is bogus because mail-delivery programs want commas, not spaces,
  67. ;;; but that's what the file format is, so we have to live with it.)
  68. ;;;
  69. ;;; If you like, you can call the function define-mail-alias to define your
  70. ;;; mail-aliases instead of using a .mailrc file.  When you call it in this
  71. ;;; way, addresses are separated by commas.
  72. ;;;
  73. ;;; CAVEAT: This works on most Sun systems; I have been told that some versions
  74. ;;; of /bin/mail do not understand double-quotes in the .mailrc file.  So you
  75. ;;; should make sure your version does before including verbose addresses like
  76. ;;; this.  One solution to this, if you are on a system whose /bin/mail doesn't
  77. ;;; work that way, (and you still want to be able to /bin/mail to send mail in
  78. ;;; addition to emacs) is to define minimal aliases (without full names) in
  79. ;;; your .mailrc file, and use define-mail-alias to redefine them when sending
  80. ;;; mail from emacs; this way, mail sent from /bin/mail will work, and mail
  81. ;;; sent from emacs will be pretty.
  82. ;;;
  83. ;;; Aliases in the mailrc file may be nested.  If you define aliases like
  84. ;;;     alias group1 fred ethel
  85. ;;;     alias group2 larry curly moe
  86. ;;;     alias everybody group1 group2
  87. ;;; Then when you type "everybody" on the To: line, it will be expanded to
  88. ;;;     fred, ethyl, larry, curly, moe
  89. ;;;
  90. ;;; Aliases may also contain forward references; the alias of "everybody" can
  91. ;;; precede the aliases of "group1" and "group2".
  92. ;;;
  93. ;;; This code also understands the "source" .mailrc command, for reading
  94. ;;; aliases from some other file as well.
  95. ;;;
  96. ;;; Aliases may contain hyphens, as in "alias foo-bar foo@bar"; word-abbrevs
  97. ;;; normally cannot contain hyphens, but this code works around that for the
  98. ;;; specific case of mail-alias word-abbrevs.
  99. ;;;
  100. ;;; To read in the contents of another .mailrc-type file from emacs, use the
  101. ;;; command Meta-X merge-mail-aliases.  The rebuild-mail-aliases command is
  102. ;;; similar, but will delete existing aliases first.
  103. ;;;
  104. ;;; If you want multiple addresses separated by a string other than ", " then
  105. ;;; you can set the variable mail-alias-separator-string to it.  This has to
  106. ;;; be a comma bracketed by whitespace if you want any kind of reasonable
  107. ;;; behaviour.
  108. ;;;
  109. ;;; Some versions of /bin/mail append the contents of multiple definitions of
  110. ;;; the same alias together, so that
  111. ;;;     alias group one two three
  112. ;;;     alias group four five
  113. ;;; would define "group" as "one two three four five" instead of "four five".
  114. ;;; This code does *not* support that syntax, because it's a horrible syntax
  115. ;;; and isn't worth the effort or added code complexity.  (So there.)
  116. ;;;
  117. ;;; Thanks to Harald Hanche-Olsen, Michael Ernst, David Loeffler, Noah
  118. ;;; Friedman, and Michelangelo Grigni for suggestions and bug reports.
  119. ;;;
  120. ;;; INSTALLATION 
  121. ;;;
  122. ;;; If you are using Emacs 18, you shouldn't have to do anything at all to
  123. ;;; install this code other than load this file.  You might want to do this
  124. ;;; to have this code loaded only when needed:
  125. ;;;
  126. ;;;     (setq mail-setup-hook '(lambda () (require 'mail-abbrevs)))
  127. ;;;
  128. ;;; Simply loading this file will redefine and overload the required 
  129. ;;; functions.
  130. ;;;
  131. ;;; If you want to install this code more permanently (instead of loading
  132. ;;; it as a patch) you need to do the following:
  133. ;;;
  134. ;;;    -  Remove the entire file mailalias.el;
  135. ;;;    -  Remove the definition of mail-aliases from sendmail.el;
  136. ;;;    -  Add a call to mail-aliases-setup to the front of the function
  137. ;;;       mail-setup in the file sendmail.el;
  138. ;;;    -  Remove the call to expand-mail-aliases from the function
  139. ;;;       sendmail-send-it in the file sendmail.el;
  140. ;;;    -  Remove the autoload of expand-mail-aliases from the file sendmail.el;
  141. ;;;    -  Remove the autoload of build-mail-aliases from the file sendmail.el;
  142. ;;;    -  Add an autoload of define-mail-alias to loaddefs.el.
  143.  
  144. (require 'sendmail)
  145.  
  146. (defgroup mail-abbrevs nil
  147.   "Mail abbreviation (addressbook)"
  148.   :group 'mail)
  149.  
  150. ;;;###autoload
  151. (defcustom mail-abbrev-mailrc-file nil
  152.   "Name of file with mail aliases.   If nil, ~/.mailrc is used."
  153.   :type '(choice (const :tag "Default" nil)
  154.          file)
  155.   :group 'mail-abbrevs)
  156.  
  157. (defmacro mail-abbrev-mailrc-file ()
  158.   '(or mail-abbrev-mailrc-file
  159.        (setq mail-abbrev-mailrc-file
  160.          (or (getenv "MAILRC") "~/.mailrc"))))
  161.  
  162. ;; originally defined in sendmail.el - used to be an alist, now is a table.
  163. ;;;###autoload
  164. (defvar mail-aliases nil
  165.   "Word-abbrev table of mail address aliases.
  166. If this is nil, it means the aliases have not yet been initialized and
  167. should be read from the .mailrc file.  (This is distinct from there being
  168. no aliases, which is represented by this being a table with no entries.)")
  169.  
  170. ;;;###autoload
  171. (defun mail-aliases-setup ()
  172.   (if (and (not (vectorp mail-aliases))
  173.        (file-exists-p (mail-abbrev-mailrc-file)))
  174.       (build-mail-aliases))
  175.   (make-local-variable 'pre-abbrev-expand-hook)
  176.   (setq pre-abbrev-expand-hook
  177.     (cond ((and (listp pre-abbrev-expand-hook)
  178.         (not (eq 'lambda (car pre-abbrev-expand-hook))))
  179.        (cons 'sendmail-pre-abbrev-expand-hook pre-abbrev-expand-hook))
  180.       (t
  181.        (list 'sendmail-pre-abbrev-expand-hook pre-abbrev-expand-hook))))
  182.   (abbrev-mode 1))
  183.  
  184. ;;; Originally defined in mailalias.el.  Changed to call define-mail-alias
  185. ;;; with an additional argument.
  186. ;;;###autoload
  187. (defun build-mail-aliases (&optional file recursivep)
  188.   "Read mail aliases from .mailrc and set mail-aliases."
  189.   (setq file (expand-file-name (or file (mail-abbrev-mailrc-file))))
  190.   (or (vectorp mail-aliases)
  191.       (setq mail-aliases (make-abbrev-table)))
  192.   (message "Parsing %s..." file)
  193.   (let ((buffer nil)
  194.     (obuf (current-buffer)))
  195.     (unwind-protect
  196.     (progn
  197.       (setq buffer (generate-new-buffer "mailrc"))
  198.       (buffer-disable-undo buffer)
  199.       (set-buffer buffer)
  200.       (cond ((get-file-buffer file)
  201.          (insert (save-excursion
  202.                (set-buffer (get-file-buffer file))
  203.                (buffer-substring (point-min) (point-max)))))
  204.         ((not (file-exists-p file)))
  205.         (t (insert-file-contents file)))
  206.       ;; Don't lose if no final newline.
  207.       (goto-char (point-max))
  208.       (or (eq (preceding-char) ?\n) (newline))
  209.       (goto-char (point-min))
  210.       ;; Delete comments from the file
  211.       (while (search-forward "# " nil t)
  212.         (let ((p (- (point) 2)))
  213.           (end-of-line)
  214.           (delete-region p (point))))
  215.       (goto-char (point-min))
  216.       ;; handle "\\\n" continuation lines
  217.       (while (not (eobp))
  218.         (end-of-line)
  219.         (if (= (preceding-char) ?\\)
  220.         (progn (delete-char -1) (delete-char 1) (insert ?\ ))
  221.             (forward-char 1)))
  222.       (goto-char (point-min))
  223.       (while (re-search-forward
  224.           "^\\(a\\(lias\\)?\\|g\\(roup\\)?\\|source\\)[ \t]+" nil t)
  225.         (beginning-of-line)
  226.         (if (looking-at "source[ \t]+\\([^ \t\n]+\\)")
  227.         (progn
  228.           (end-of-line)
  229.           (build-mail-aliases
  230.            (substitute-in-file-name
  231.             (buffer-substring (match-beginning 1) (match-end 1)))
  232.            t))
  233.           (re-search-forward "[ \t]+\\([^ \t\n]+\\)")
  234.           (let* ((name (buffer-substring
  235.                 (match-beginning 1) (match-end 1)))
  236.              (start (progn (skip-chars-forward " \t") (point))))
  237.         (end-of-line)
  238. ;        (message "** %s \"%s\"" name (buffer-substring start (point)))(sit-for 1)
  239.         (define-mail-alias
  240.             name
  241.             (buffer-substring start (point))
  242.             t))))
  243.       ;; Resolve forward references in .mailrc file.
  244.       ;; This would happen automatically before the first abbrev was
  245.       ;; expanded, but why not do it now.
  246.       (or recursivep (mail-resolve-all-aliases))
  247.       )
  248.       (if buffer (kill-buffer buffer))
  249.       (set-buffer obuf)))
  250.     (message "Parsing %s... done" file))
  251.  
  252. (defcustom mail-alias-separator-string ", "
  253.   "*A string inserted between addresses in multi-address mail aliases.
  254. This has to contain a comma, so \", \" is a reasonable value.  You might 
  255. also want something like \",\\n    \" to get each address on its own line."
  256.   :type 'string
  257.   :group 'mail-abbrevs)
  258.  
  259. ;; define-mail-alias sets this flag, which causes mail-resolve-all-aliases
  260. ;; to be called before expanding abbrevs if it's necessary.
  261. (defvar mail-abbrev-aliases-need-to-be-resolved t)
  262.  
  263. ;; originally defined in mailalias.el ; build-mail-aliases calls this with
  264. ;; stuff parsed from the .mailrc file.
  265. ;;
  266. ;;;###autoload
  267. (defun define-mail-alias (name definition &optional from-mailrc-file)
  268.   "Define NAME as a mail-alias that translates to DEFINITION.
  269. If DEFINITION contains multiple addresses, separate them with commas."
  270.   ;; When this is called from build-mail-aliases, the third argument is
  271.   ;; true, and we do some evil space->comma hacking like /bin/mail does.
  272.   (interactive "sDefine mail alias: \nsDefine %s as mail alias for: ")
  273.   ;; Read the defaults first, if we have not done so.
  274.   (if (vectorp mail-aliases)
  275.       nil
  276.     (setq mail-aliases (make-abbrev-table))
  277.     (if (file-exists-p (mail-abbrev-mailrc-file))
  278.     (build-mail-aliases)))
  279.   ;; strip garbage from front and end
  280.   (if (string-match "\\`[ \t\n,]+" definition)
  281.       (setq definition (substring definition (match-end 0))))
  282.   (if (string-match "[ \t\n,]+\\'" definition)
  283.       (setq definition (substring definition 0 (match-beginning 0))))
  284.   (let ((result '())
  285.     (start 0)
  286.     (L (length definition))
  287.     end)
  288.     (while start
  289.       ;; If we're reading from the mailrc file, then addresses are delimited
  290.       ;; by spaces, and addresses with embedded spaces must be surrounded by
  291.       ;; single or double-quotes.  Otherwise, addresses are separated by
  292.       ;; commas.
  293.       (if from-mailrc-file
  294.       (cond ((eq ?\" (aref definition start))
  295.          (setq start (1+ start)
  296.                end (string-match "\"[ \t,]*" definition start)))
  297.         ((eq ?\' (aref definition start))
  298.          (setq start (1+ start)
  299.                end (string-match "\'[ \t,]*" definition start)))
  300.         (t
  301.          (setq end (string-match "[ \t,]+" definition start))))
  302.     (setq end (string-match "[ \t\n,]*,[ \t\n,]*" definition start)))
  303.       (setq result (cons (substring definition start end) result))
  304.       (setq start (and end
  305.                (/= (match-end 0) L)
  306.                (match-end 0))))
  307.     (setq definition (mapconcat (function identity)
  308.                 (nreverse result)
  309.                 mail-alias-separator-string)))
  310.   (setq mail-abbrev-aliases-need-to-be-resolved t)
  311.   (setq name (downcase name))
  312.   ;; use an abbrev table instead of an alist for mail-aliases.
  313.   (let ((abbrevs-changed abbrevs-changed))  ; protect this from being changed.
  314.     (define-abbrev mail-aliases name definition 'mail-abbrev-expand-hook)))
  315.  
  316.  
  317. (defun mail-resolve-all-aliases ()
  318.   "Resolve all forward references in the mail aliases table."
  319.   (if mail-abbrev-aliases-need-to-be-resolved
  320.       (progn
  321. ;;    (message "Resolving mail aliases...")
  322.     (if (vectorp mail-aliases)
  323.         (mapatoms (function mail-resolve-all-aliases-1) mail-aliases))
  324.     (setq mail-abbrev-aliases-need-to-be-resolved nil)
  325. ;;    (message "Resolving mail aliases... done.")
  326.     )))
  327.  
  328. (defun mail-resolve-all-aliases-1 (sym &optional so-far)
  329.   (if (memq sym so-far)
  330.       (error "mail alias loop detected: %s"
  331.          (mapconcat 'symbol-name (cons sym so-far) " <- ")))
  332.   (let ((definition (and (boundp sym) (symbol-value sym))))
  333.     (if definition
  334.     (let ((result '())
  335.           (start 0))
  336.       (while start
  337.         (let ((end (string-match "[ \t\n]*,[, \t\n]*" definition start)))
  338.           (setq result (cons (substring definition start end) result)
  339.             start (and end (match-end 0)))))
  340.       (setq definition
  341.         (mapconcat (function (lambda (x)
  342.                  (or (mail-resolve-all-aliases-1
  343.                    (intern-soft (downcase x) mail-aliases)
  344.                    (cons sym so-far))
  345.                  x)))
  346.                (nreverse result)
  347.                mail-alias-separator-string))
  348.       (set sym definition))))
  349.   (symbol-value sym))
  350.  
  351.  
  352. (defun mail-abbrev-expand-hook ()
  353.   "For use as the fourth arg to define-abbrev.
  354. After expanding a mail-abbrev, if fill-mode is on and we're past the
  355. fill-column, break the line at the previous comma, and indent the next
  356. line."
  357.   (save-excursion
  358.     (let ((p (point))
  359.       bol comma fp)
  360.       (beginning-of-line)
  361.       (setq bol (point))
  362.       (goto-char p)
  363.       (while (and auto-fill-function
  364.           (>= (current-column) fill-column)
  365.           (search-backward "," bol t))
  366.     (setq comma (point))
  367.     (forward-char 1)        ; Now we are just past the comma.
  368.     (insert "\n")
  369.     (delete-horizontal-space)
  370.      (setq p (point))
  371.     ;; Prevent abbrev expansion from happening again, since
  372.     ;; sendmail-pre-abbrev-expand-hook will already have done it.
  373.     (let ((abbrev-mode nil))
  374.       (indent-relative))
  375.     (setq fp (buffer-substring p (point)))
  376.     ;; Go to the end of the new line.
  377.     (end-of-line)
  378.     (if (> (current-column) fill-column)
  379.         ;; It's still too long; do normal auto-fill.
  380.         (let ((fill-prefix (or fp "\t")))
  381.           (do-auto-fill)))
  382.     ;; Resume the search.
  383.     (goto-char comma)
  384.     ))))
  385.  
  386. ;;; Syntax tables and abbrev-expansion
  387.  
  388. (defcustom mail-abbrev-mode-regexp
  389.   "^\\(Resent-\\)?\\(To\\|From\\|CC\\|BCC\\|Reply-to\\):"
  390.   "*Regexp to select mail-headers in which mail aliases should be expanded.
  391. This string it will be handed to `looking-at' with the point at the beginning
  392. of the current line; if it matches, abbrev mode will be turned on, otherwise
  393. it will be turned off.  (You don't need to worry about continuation lines.)
  394. This should be set to match those mail fields in which you want abbreviations
  395. turned on."
  396.   :type 'regexp
  397.   :group 'mail-abbrevs)
  398.  
  399. (defvar mail-mode-syntax-table (copy-syntax-table text-mode-syntax-table)
  400.   "The syntax table which is used in send-mail mode message bodies.")
  401.  
  402. (defvar mail-mode-header-syntax-table
  403.   (let ((tab (copy-syntax-table text-mode-syntax-table)))
  404.     ;; This makes the characters "@%!._-" be considered symbol-consituents
  405.     ;; but not word-constituents, so forward-sexp will move you over an
  406.     ;; entire address, but forward-word will only move you over a sequence
  407.     ;; of alphanumerics.  (Clearly the right thing.)
  408.     (modify-syntax-entry ?@ "_" tab)
  409.     (modify-syntax-entry ?% "_" tab)
  410.     (modify-syntax-entry ?! "_" tab)
  411.     (modify-syntax-entry ?. "_" tab)
  412.     (modify-syntax-entry ?_ "_" tab)
  413.     (modify-syntax-entry ?- "_" tab)
  414.     (modify-syntax-entry ?< "(>" tab)
  415.     (modify-syntax-entry ?> ")<" tab)
  416.     tab)
  417.   "The syntax table used in send-mail mode when in a mail-address header.
  418. mail-mode-syntax-table is used when the cursor is in the message body or in
  419. non-address headers.")
  420.  
  421. (defvar mail-abbrev-syntax-table
  422.   (let ((tab (copy-syntax-table mail-mode-header-syntax-table)))
  423.     (if (vectorp tab)
  424.     (let ((i (1- (length tab)))
  425.           (_ (aref (standard-syntax-table) ?_))
  426.           (w (aref (standard-syntax-table) ?w)))
  427.       (while (>= i 0)
  428.         (if (= (aref tab i) _) (aset tab i w))
  429.         (setq i (1- i))))
  430.       (map-syntax-table
  431.        #'(lambda (key val)
  432.        (if (eq (char-syntax-from-code val) ?_)
  433.            (put-char-table key (set-char-syntax-in-code val ?w) tab)
  434.            ))
  435.        tab))
  436.     tab)
  437.   "The syntax-table used for abbrev-expansion purposes; this is not actually
  438. made the current syntax table of the buffer, but simply controls the set of
  439. characters which may be a part of the name of a mail-alias.")
  440.  
  441.  
  442. (defun mail-abbrev-in-expansion-header-p ()
  443.   "Whether point is in a mail-address header field."
  444.   (let ((case-fold-search t))
  445.     (and ;;
  446.          ;; we are on an appropriate header line...
  447.      (save-excursion
  448.        (beginning-of-line)
  449.        ;; skip backwards over continuation lines.
  450.        (while (and (looking-at "^[ \t]")
  451.            (not (= (point) (point-min))))
  452.      (forward-line -1))
  453.        ;; are we at the front of an appropriate header line?
  454.        (looking-at mail-abbrev-mode-regexp))
  455.      ;;
  456.      ;; ...and we are before the mail-header-separator
  457.      (< (point)
  458.     (save-excursion
  459.       (goto-char (point-min))
  460.       (search-forward (concat "\n" mail-header-separator "\n")
  461.               nil 0)
  462.       (point))))))
  463.  
  464. (defvar mail-mode-abbrev-table) ; quiet the compiler
  465.  
  466. (defun sendmail-pre-abbrev-expand-hook ()
  467.   (if mail-abbrev-aliases-need-to-be-resolved
  468.       (mail-resolve-all-aliases))
  469.   (if (and mail-aliases (not (eq mail-aliases t)))
  470.       (if (not (mail-abbrev-in-expansion-header-p))
  471.       ;;
  472.       ;; If we're not in a mail header in which mail aliases should
  473.       ;; be expanded, then use the normal mail-mode abbrev table (if any)
  474.       ;; and the normal mail-mode syntax table.
  475.       ;;
  476.       (progn
  477.         (setq local-abbrev-table (and (boundp 'mail-mode-abbrev-table)
  478.                       mail-mode-abbrev-table))
  479.         (set-syntax-table mail-mode-syntax-table))
  480.     ;;
  481.     ;; Otherwise, we are in a To: (or CC:, or whatever) header, and
  482.     ;; should use word-abbrevs to expand mail aliases.
  483.     ;;   -  First, install the mail-aliases as the word-abbrev table.
  484.     ;;   -  Then install the mail-abbrev-syntax-table, which temporarily
  485.     ;;      marks all of the non-alphanumeric-atom-characters (the "_"
  486.     ;;      syntax ones) as being normal word-syntax.  We do this because
  487.     ;;      the C code for expand-abbrev only works on words, and we want
  488.     ;;      these characters to be considered words for the purpose of
  489.     ;;      abbrev expansion.
  490.     ;;   -  Then we call expand-abbrev again, recursively, to do the abbrev
  491.     ;;      expansion with the above syntax table.
  492.     ;;   -  Then we do a trick which tells the expand-abbrev frame which
  493.     ;;      invoked us to not continue (and thus not expand twice.)
  494.     ;;      This means that any abbrev expansion will happen as a result
  495.     ;;      of this function's call to expand-abbrev, and not as a result
  496.     ;;      of the call to expand-abbrev which invoked *us*.
  497.     ;;   -  Then we set the syntax table to mail-mode-header-syntax-table,
  498.     ;;      which doesn't have anything to do with abbrev expansion, but
  499.     ;;      is just for the user's convenience (see its doc string.)
  500.     ;;
  501.     (setq local-abbrev-table mail-aliases)
  502.     ;; If the character just typed was non-alpha-symbol-syntax, then don't
  503.     ;; expand the abbrev now (that is, don't expand when the user types -.)
  504.     ;; Check the character's syntax in the mail-mode-header-syntax-table.
  505.     (set-syntax-table mail-mode-header-syntax-table)
  506.     (or (and last-command-char
  507.          (eq (char-syntax last-command-char) ?_))
  508.         (let ((pre-abbrev-expand-hook nil)) ; That's us; don't loop.
  509.           ;; Use this table so that abbrevs can have hyphens in them.
  510.           (set-syntax-table mail-abbrev-syntax-table)
  511.           (expand-abbrev)
  512.           ;; Now set it back to what it was before.
  513.           (set-syntax-table mail-mode-header-syntax-table)))
  514.     (setq abbrev-start-location (point)  ; This is the trick.
  515.           abbrev-start-location-buffer (current-buffer))
  516.     )))
  517.  
  518.  
  519. ;;; Reading addresses from the minibuffer; by David Hughes <djh@Harston.CV.COM>
  520.  
  521. (defun mail-abbrev-minibuffer-setup-hook ()
  522.   ;; Use as the value of minibuffer-setup-hook when reading addresses
  523.   ;; from the minibuffer, as in:
  524.   ;;  (let ((minibuffer-setup-hook 'mail-abbrev-minibuffer-setup-hook))
  525.   ;;    (read-string "Who: "))
  526.   (if (and (not (vectorp mail-aliases))
  527.        (file-exists-p (mail-abbrev-mailrc-file)))
  528.       (build-mail-aliases))
  529.   (make-local-variable 'pre-abbrev-expand-hook)
  530.   (setq pre-abbrev-expand-hook
  531.     (function
  532.      (lambda ()
  533.        (setq local-abbrev-table mail-aliases)
  534.        (set-syntax-table mail-mode-header-syntax-table)
  535.        (or (and last-command-char
  536.             (eq (char-syntax last-command-char) ?_))
  537.            (let ((pre-abbrev-expand-hook nil)) ; That's us; don't loop.
  538.          ;; Use this table so that abbrevs can have hyphens in them.
  539.          (set-syntax-table mail-abbrev-syntax-table)
  540.          (expand-abbrev)
  541.          ;; Now set it back to what it was before.
  542.          (set-syntax-table mail-mode-header-syntax-table)))
  543.        (setq abbrev-start-location (point)  ; This is the trick.
  544.          abbrev-start-location-buffer (current-buffer)))))
  545.   (abbrev-mode 1))
  546.  
  547.  
  548. ;;; utilities
  549.  
  550. (defun merge-mail-aliases (file)
  551.   "Merge mail aliases from the given file with existing ones."
  552.   (interactive (list
  553.         (let ((insert-default-directory t)
  554.               (default-directory (expand-file-name "~/"))
  555.               (def (mail-abbrev-mailrc-file)))
  556.           (read-file-name
  557.             (format "Read additional aliases from file: (default %s) "
  558.                 def)
  559.             default-directory
  560.             (expand-file-name def default-directory)
  561.             t))))
  562.   (build-mail-aliases file))
  563.  
  564. (defun rebuild-mail-aliases (file)
  565.   "Rebuild all the mail aliases from the given file."
  566.   (interactive (list
  567.         (let ((insert-default-directory t)
  568.               (default-directory (expand-file-name "~/"))
  569.               (def (mail-abbrev-mailrc-file)))
  570.           (read-file-name
  571.            (format "Read mail aliases from file: (default %s) " def)
  572.            default-directory
  573.            (expand-file-name def default-directory)
  574.            t))))
  575.   (setq mail-aliases nil)
  576.   (build-mail-aliases file))
  577.  
  578. (defun mail-interactive-insert-alias (&optional alias)
  579.   "Prompt for and insert a mail alias."
  580.   (interactive (progn
  581.         (if (not (vectorp mail-aliases)) (mail-aliases-setup))
  582.         (list (completing-read "Expand alias: " mail-aliases nil t))))
  583.   (if (not (vectorp mail-aliases)) (mail-aliases-setup))
  584.   (insert (or (and alias (symbol-value (intern-soft alias mail-aliases))) "")))
  585.  
  586. ;; call-interactively is so that zmacs-regions gets hacked correctly
  587. ;; without making the interactive specs incompatible with v18.
  588.  
  589. (defun abbrev-hacking-next-line ()
  590.   "Just like `next-line' (\\<global-map>\\[next-line]) but expands abbrevs \
  591. when at end of line."
  592.   (interactive)
  593.   (if (and (looking-at "[ \t]*\n")
  594.        (= (char-syntax (preceding-char)) ?w))
  595.       (expand-abbrev))
  596.   (setq this-command 'next-line)
  597.   (call-interactively 'next-line))
  598.  
  599. (defun abbrev-hacking-end-of-buffer ()
  600.   "Just like `end-of-buffer' (\\<global-map>\\[end-of-buffer]) but expands \
  601. abbrevs when at end of buffer."
  602.   (interactive)
  603.   (if (and (looking-at "[ \t]*\n")
  604.        (= (char-syntax (preceding-char)) ?w))
  605.       (expand-abbrev))
  606.   (setq this-command 'end-of-buffer)
  607.   (call-interactively 'end-of-buffer))
  608.  
  609. (define-key mail-mode-map "\C-c\C-a" 'mail-interactive-insert-alias)
  610.  
  611. ;(define-key mail-mode-map "\C-n" 'abbrev-hacking-next-line)
  612. ;(define-key mail-mode-map "\M->" 'abbrev-hacking-end-of-buffer)
  613. (let ((subst '((next-line       . abbrev-hacking-next-line)
  614.            (fkey-next-line       . abbrev-hacking-next-line)
  615.            (end-of-buffer       . abbrev-hacking-end-of-buffer)
  616.            (fkey-end-of-buffer . abbrev-hacking-end-of-buffer)
  617.            )))
  618.   (while subst
  619.     (let ((keys
  620.        (delq nil
  621.          (nconc (where-is-internal (car (car subst)) mail-mode-map)
  622.             (where-is-internal (car (car subst)))))))
  623.       (while keys
  624.     (define-key mail-mode-map (car keys) (cdr (car subst)))
  625.     (setq keys (cdr keys))))
  626.     (setq subst (cdr subst))))
  627.  
  628. (provide 'mail-abbrevs)
  629.  
  630.  
  631. ;;; V18 compatibility
  632. ;;;
  633. ;;; All of the Emacs18 stuff is isolated down here so that it will be
  634. ;;; easy to delete once v18 finally bites the dust.
  635. ;;;
  636. ;;; These defuns and defvars aren't inside the cond in deference to
  637. ;;; the intense brokenness of the v18 byte-compiler.
  638. ;;;
  639. ;;; All the code on this page is gross and hidious and awful and might
  640. ;;; not even work all that well.  Comfort yourself with knowing that the
  641. ;;; v19 code above works wonderfully.
  642.  
  643. (defun sendmail-v18-self-insert-command (arg)
  644.   "Just like self-insert-command, but runs sendmail-pre-abbrev-expand-hook."
  645.   (interactive "p")
  646.   (if (not (and last-command-char
  647.         (eq (char-syntax last-command-char) ?w)))
  648.       (progn
  649.     (sendmail-pre-abbrev-expand-hook)
  650.         ;; Unhack expand-abbrev, so it will work right next time around.
  651.     (setq abbrev-start-location nil)))
  652.   ;; this is gross and wasteful.
  653.   (let ((abbrev-mode (if (mail-abbrev-in-expansion-header-p)
  654.              nil
  655.                abbrev-mode)))
  656.     (self-insert-command arg)))
  657.  
  658. (defun abbrev-hacking-next-line-v18 (arg)
  659.   (if (looking-at "[ \t]*\n") (sendmail-pre-abbrev-expand-hook))
  660.   (setq this-command 'next-line)
  661.   (next-line arg))
  662.  
  663. (defun abbrev-hacking-end-of-buffer-v18 (arg)
  664.   (if (looking-at "[ \t]*\n") (sendmail-pre-abbrev-expand-hook))
  665.   (setq this-command 'end-of-buffer)
  666.   (end-of-buffer arg))
  667.  
  668. (defvar mail-abbrevs-v18-map-munged nil)
  669.  
  670. (defun mail-abbrevs-v18-munge-map ()
  671.   ;; For every key that is bound to self-insert-command in global-map,
  672.   ;; bind that key to sendmail-self-insert-command in mail-mode-map.
  673.   ;; We used to do this by making the mail-mode-map be a non-sparse map,
  674.   ;; but that made the esc-map be shared in such a way that making a
  675.   ;; local meta binding in the mail-mode-map made a *global* binding
  676.   ;; instead.  Yucko.
  677.   (let ((global-map (current-global-map))
  678.     new-bindings
  679.     (i 0))
  680.     (while (< i 128)
  681.       (if (eq 'self-insert-command (or (cdr (assq i mail-mode-map))
  682.                        (aref global-map i)))
  683.       (setq new-bindings
  684.         (cons (cons i 'sendmail-v18-self-insert-command)
  685.               new-bindings)))
  686.       (setq i (1+ i)))
  687.     (setq mail-mode-map
  688.       (nconc (copy-keymap mail-mode-map) (nreverse new-bindings))))
  689.   (setq mail-abbrevs-v18-map-munged t))
  690.  
  691. (defun mail-aliases-setup-v18 ()
  692.   "Put this on `mail-setup-hook' to use mail-abbrevs."
  693.   (if (not (eq major-mode 'mail-mode))
  694.       nil
  695.     (or (and mail-mode-map (eq (current-local-map) mail-mode-map))
  696.     (error "shut 'er down clancy, she's suckin' mud"))
  697.     (if (and (not (vectorp mail-aliases))
  698.          (file-exists-p (mail-abbrev-mailrc-file)))
  699.     (build-mail-aliases))
  700.     (or mail-abbrevs-v18-map-munged (mail-abbrevs-v18-munge-map))
  701.     (use-local-map mail-mode-map)
  702.     (abbrev-mode 1)))
  703.  
  704.  
  705. (cond ((or (string-match "^18\\." emacs-version)
  706.        (and (boundp 'epoch::version) epoch::version))
  707.        ;;
  708.        ;; v19 (and this code) uses a new name for this function.
  709.        (or (fboundp 'buffer-disable-undo)
  710.        (fset 'buffer-disable-undo 'buffer-flush-undo))
  711.        ;;
  712.        ;; v19 (and this code) uses a new name for auto-fill-hook (-function).
  713.        ;; Encapsulate the function that uses it to bind the new name.
  714.        (or (fboundp 'mail-abbrev-expand-hook-v19)
  715.        (fset 'mail-abbrev-expand-hook-v19
  716.          (symbol-function 'mail-abbrev-expand-hook)))
  717.        (fset 'mail-abbrev-expand-hook
  718.          (function (lambda ()
  719.              (let ((auto-fill-function auto-fill-hook))
  720.                (mail-abbrev-expand-hook-v19)))))
  721.        ;;
  722.        ;; Turn off the broken v18 code (that is still called from sendmail.el)
  723.        (fset 'expand-mail-aliases
  724.          (function (lambda (&rest args)
  725.              "Obsoleted by mail-abbrevs.  Does nothing."
  726.              nil)))
  727.        ;;
  728.        ;; Redefine the abbrev-hacking functions.  Yuck.
  729.        (fset 'abbrev-hacking-next-line
  730.          (function (lambda (p) (interactive "p")
  731.              (abbrev-hacking-next-line-v18 p))))
  732.        (fset 'abbrev-hacking-end-of-buffer
  733.          (function (lambda (p) (interactive "P")
  734.              (abbrev-hacking-end-of-buffer-v18 p))))
  735.        ;;
  736.        ;; Encapsulate mail-setup to do the necessary buffer initializations.
  737.        (or (fboundp 'mail-setup-v18)
  738.        (fset 'mail-setup-v18 (symbol-function 'mail-setup)))
  739.        (fset 'mail-setup
  740.          (function (lambda (&rest args)
  741.              (mail-aliases-setup-v18)
  742.              (apply 'mail-setup-v18 args))))
  743.  
  744.        ;;
  745.        ;; Encapsulate VM's version of mail-setup as well, if vm-mail is
  746.        ;; defined as a function or as an autoload.
  747.        (cond ((and (fboundp 'vm-mail)
  748.            (if (eq 'autoload (car-safe (symbol-function 'vm-mail)))
  749.                (load (nth 1 (symbol-function 'vm-mail)) t)
  750.              t))
  751.           (or (fboundp 'vm-mail-internal-v18)
  752.           (fset 'vm-mail-internal-v18
  753.             (symbol-function 'vm-mail-internal)))
  754.           (fset 'vm-mail-internal
  755.             (function (lambda (&rest args)
  756.                 (apply 'vm-mail-internal-v18 args)
  757.                 (mail-aliases-setup-v18))))))
  758.  
  759.        ;; If we're being loaded from mail-setup-hook or mail-mode-hook
  760.        ;; as run from inside mail-setup or vm-mail-internal, then install
  761.        ;; right now.
  762.        (if (eq major-mode 'mail-mode)
  763.        (mail-aliases-setup-v18))
  764.        )
  765.  
  766.       (t ; v19
  767.        (fmakunbound 'expand-mail-aliases)))
  768.